home *** CD-ROM | disk | FTP | other *** search
/ System Booster / System Booster.iso / Texteditors / Origami / bindings / fun / go-match < prev    next >
Encoding:
Text File  |  1996-09-27  |  10.1 KB  |  301 lines
  1. ;OCL{{{}}}
  2. ;OCL{{{  comments
  3. ; Jump from [,{ or ( to a matching ],} or ).
  4. ; if no match can be found, a errormessage appears.
  5. ; matching-fence-y and matching-fence-x are set to the calling position.
  6. ; if you use the function abort-hook-add in your abort handling function,
  7. ; pressing abort during search will move the cursor back to the calling
  8. ; position!
  9. ;OCL}}}
  10. @if-using not(ocl-file-go-match)
  11.   @use (ocl-file-go-match)
  12.   ;OCL{{{  libs
  13.   @if-using not(ocl-file-error)     @lib error     @fi
  14.   @if-using not(ocl-file-go-line)   @lib go-line   @fi
  15.   @if-using not(ocl-file-pre-char)  @lib pre-char  @fi
  16.   @if-using not(ocl-file-next-char) @lib next-char @fi
  17.   @use ( language-ocl )
  18.   @if-using not(ocl-file-userlang)  @lib userlang  @fi
  19.   @use not( language-ocl )
  20.   ;OCL}}}
  21.   ;OCL{{{  vars
  22.   ( defvar
  23.      ( matching-fence-y ; calling-position
  24.        matching-fence-x ;        "
  25.        matching-search  ; is search active
  26.        fence-counter    ; number of found fences
  27.        i-f              ; complex fence leading character
  28.        s-f              ; start-fence-char or complex fence typ
  29.        e-f              ; end-fence-char
  30.        d-f-1            ; first operation, used to move to next test position
  31.        d-f-2            ; second operation, used to move to next test position
  32.      )
  33.   )
  34.   ;OCL}}}
  35.   ;OCL{{{  goto-matching-fence
  36.   ( deffun goto-matching-fence
  37.      ( if and(not(in-prompt) test-text)
  38.         ;OCL{{{  goto
  39.         (
  40.           ;OCL{{{  store current x position
  41.           set matching-fence-x store-pos
  42.           ;OCL}}}
  43.           ;OCL{{{  which fence-type
  44.           set d-f-1 forward-text-character
  45.           set d-f-2 no-operation
  46.           set i-f 0
  47.           case
  48.            ;OCL{{{  ([{}])
  49.            ( test-char "{ ( set s-f "{ set e-f "} ) )
  50.            ( test-char "[ ( set s-f "[ set e-f "] ) )
  51.            ( test-char "( ( set s-f "( set e-f ") ) )
  52.            ( test-char "} ( set s-f "} set e-f "{ set d-f-1 previous-text-character ) )
  53.            ( test-char "] ( set s-f "] set e-f "[ set d-f-1 previous-text-character ) )
  54.            ( test-char ") ( set s-f ") set e-f "( set d-f-1 previous-text-character ) )
  55.            ;OCL}}}
  56.           default
  57.            ;OCL{{{  #ifdef/#else/#endif @if-using/@fi
  58.              ( set s-f 0
  59.                screen-off
  60.                ;OCL{{{  set s-f to complex fence typ
  61.                ;OCL{{{  maybe ocl: -4 if-using/ -5 fi
  62.                if test-language-ocl
  63.                 ( do
  64.                    ( if not(test-char "@) ( backward-character ) fi
  65.                      if test-char "@
  66.                       ( forward-character
  67.                         case
  68.                          ;OCL{{{  if-using
  69.                          ( test-str "if-using ( set s-f -5 ) )
  70.                          ;OCL}}}
  71.                          ;OCL{{{  fi
  72.                          ( test-str "fi       ( set s-f -4 ) )
  73.                          ;OCL}}}
  74.                         default
  75.                          ;OCL{{{  not handled OCL-command
  76.                          ( backward-character )
  77.                          ;OCL}}}
  78.                         esac
  79.                       )
  80.                      fi
  81.                    )
  82.                   while and(>(store-pos 1) =(s-f 0))
  83.                 )
  84.                fi
  85.                ;OCL}}}
  86.                ;OCL{{{  maybe cpp: -1 if / -2 else / -3 endif
  87.                if =(s-f 0)
  88.                 ( beginning-of-line
  89.                   if test-char "#
  90.                    ( next-non-space-on-line
  91.                      case
  92.                       ;OCL{{{  if      matches ifdef too
  93.                       ( test-str "if ( set s-f -2 ) )
  94.                       ;OCL}}}
  95.                       ;OCL{{{  else
  96.                       ( test-str "else ( set s-f -3 ) )
  97.                       ;OCL}}}
  98.                       ;OCL{{{  endif
  99.                       ( test-str "endif ( set s-f -1 )
  100.                       )
  101.                       ;OCL}}}
  102.                      esac
  103.                    )
  104.                   fi
  105.                 )
  106.                fi
  107.                ;OCL}}}
  108.                ;OCL}}}
  109.                screen-on
  110.                case
  111.                 ;OCL{{{  no complex type given, return
  112.                 ( not(s-f)
  113.                    ( goto matching-fence-x
  114.                      refresh-line
  115.                      return-from-macro
  116.                    )
  117.                 )
  118.                 ;OCL}}}
  119.                 ;OCL{{{  ocl
  120.                 ( <(s-f -3)
  121.                    ( set i-f "@
  122.                      if =(s-f -4)
  123.                       ( set d-f-1 previous-text-character
  124.                         backward-character
  125.                       )
  126.                      else
  127.                       ( ;set d-f-1 forward-text-character
  128.                         ; this is the default
  129.                       )
  130.                      fi
  131.                      ;set d-f-2 no-operation
  132.                      ; this is the default
  133.                    )
  134.                 )
  135.                 ;OCL}}}
  136.                default
  137.                 ;OCL{{{  cpp
  138.                 ( set i-f "#
  139.                   if =(s-f -1)
  140.                    ( set d-f-1 previous-text-line )
  141.                   else
  142.                    ( set d-f-1 next-text-line )
  143.                   fi
  144.                   set d-f-2 beginning-of-line
  145.                 )
  146.                 ;OCL}}}
  147.                esac
  148.              )
  149.            ;OCL}}}
  150.           esac
  151.           ;OCL}}}
  152.           ;OCL{{{  store current y position
  153.           set matching-fence-y store-line
  154.           ;OCL}}}
  155.           message ( "[ M_SEARCH "  "match "] )
  156.           screen-off
  157.           ;OCL{{{  search-loop
  158.           set fence-counter 1
  159.           set matching-search true
  160.           do
  161.            ( insert-ascii d-f-1
  162.              insert-ascii d-f-2
  163.              case
  164.               ;OCL{{{  char-leading-complex-fence
  165.               ( and(i-f test-char i-f)
  166.                  ( next-non-space-on-line
  167.                    case
  168.                     ;OCL{{{  ocl: if-using/fi
  169.                     ( <(s-f -3)
  170.                        ( case
  171.                           ;OCL{{{  if-using
  172.                           ( test-str "if-using
  173.                              ( if <>(s-f -4)
  174.                                 ( set fence-counter +(fence-counter 1) )
  175.                                else
  176.                                 ( set fence-counter -(fence-counter 1) )
  177.                                fi
  178.                              )
  179.                           )
  180.                           ;OCL}}}
  181.                           ;OCL{{{  fi
  182.                           ( and
  183.                              ( test-str "fi
  184.                                pre
  185.                                 ( forward-character forward-character )
  186.                                   or(test-char-set space test-end-line)
  187.                              )
  188.                              ( if <>(s-f -4)
  189.                                 ( set fence-counter -(fence-counter 1) )
  190.                                else
  191.                                 ( set fence-counter +(fence-counter 1) )
  192.                                fi
  193.                              )
  194.                           )
  195.                           ;OCL}}}
  196.                          esac
  197.                          ;OCL{{{  skip back to @
  198.                          do
  199.                           ( backward-character )
  200.                          while not(test-char "@ )
  201.                          ;OCL}}}
  202.                        )
  203.                     )
  204.                     ;OCL}}}
  205.                    default
  206.                     ;OCL{{{  cpp: if/else/endif
  207.                     ( case
  208.                        ;OCL{{{  if
  209.                        ( test-str "if
  210.                           ( if <>(s-f -1)
  211.                              ( set fence-counter +(fence-counter 1) )
  212.                             else
  213.                              ( set fence-counter -(fence-counter 1) )
  214.                             fi
  215.                           )
  216.                        )
  217.                        ;OCL}}}
  218.                        ;OCL{{{  else
  219.                        ( test-str "else
  220.                           ( if and(=(s-f -2) =(fence-counter 1))
  221.                              ( set fence-counter 0 )
  222.                             fi
  223.                           )
  224.                        )
  225.                        ;OCL}}}
  226.                        ;OCL{{{  endif
  227.                        ( test-str "endif
  228.                           ( if <>(s-f -1)
  229.                              ( set fence-counter -(fence-counter 1) )
  230.                             else
  231.                              ( set fence-counter +(fence-counter 1) )
  232.                             fi
  233.                           )
  234.                        )
  235.                        ;OCL}}}
  236.                       esac
  237.                     )
  238.                     ;OCL}}}
  239.                    esac
  240.                  )
  241.               )
  242.               ;OCL}}}
  243.               ;OCL{{{  start-simple-fence
  244.               ( test-char s-f ( set fence-counter +(fence-counter 1) ) )
  245.               ;OCL}}}
  246.               ;OCL{{{  end-simple-fence
  247.               ( test-char e-f ( set fence-counter +(fence-counter -1)) )
  248.               ;OCL}}}
  249.              esac
  250.            )
  251.           while not(or(test-bottom test-top =(fence-counter 0)))
  252.           set matching-search false
  253.           ;OCL}}}
  254.           if or(test-top test-bottom)
  255.            ;OCL{{{  failed!
  256.            ( set go-line-arg matching-fence-y
  257.              go-line
  258.              goto matching-fence-x
  259.              screen-on
  260.              redraw-display
  261.              failed
  262.            )
  263.            ;OCL}}}
  264.           else
  265.            ;OCL{{{  show new position
  266.            ( screen-on
  267.              message ( )
  268.              redraw-display
  269.            )
  270.            ;OCL}}}
  271.           fi
  272.         )
  273.         ;OCL}}}
  274.        fi
  275.      )
  276.   )
  277.   ;OCL}}}
  278.   ;OCL{{{  abort-hook-add
  279.   @if-using not(ABORT-HOOK-ADD)
  280.      @use (ABORT-HOOK-ADD)
  281.      ( defmac abort-hook-add ( ) )
  282.   @fi
  283.   ( defmac abort-hook-add-saved ( abort-hook-add ) )
  284.   ( undeclare ( abort-hook-add ) )
  285.   ( defmac abort-hook-add
  286.      ( if matching-search
  287.         ( set matching-search false
  288.           goto-line-mark matching-fence-y
  289.           goto matching-fence-x
  290.         )
  291.        fi
  292.        abort-hook-add-saved
  293.      )
  294.   )
  295.   ( undeclare ( abort-hook-add-saved ) )
  296.   ;OCL}}}
  297.   ;OCL{{{  undeclare
  298.   ( undeclare ( fence-counter i-f s-f e-f d-f-1 d-f-2 ) )
  299.   ;OCL}}}
  300. @fi
  301.